home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Property Editors / fldlinks.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  15KB  |  537 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {       Master/Detail Field Links Editor                }
  6. {                                                       }
  7. {       Copyright (c) 1997,99 Inprise Corporation       }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit Fldlinks;
  12.  
  13. interface
  14.  
  15. uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms,
  16.   StdCtrls, ExtCtrls, DB, Buttons, DsgnIntf;
  17.  
  18. type
  19.  
  20. { TFieldLink }
  21.  
  22.   TFieldLinkProperty = class(TStringProperty)
  23.   private
  24.     FChanged: Boolean;
  25.     FDataSet: TDataSet;
  26.   protected
  27.     function GetDataSet: TDataSet;
  28.     procedure GetFieldNamesForIndex(List: TStrings); virtual;
  29.     function GetIndexBased: Boolean; virtual;
  30.     function GetIndexDefs: TIndexDefs; virtual;
  31.     function GetIndexFieldNames: string; virtual;
  32.     function GetIndexName: string; virtual;
  33.     function GetMasterFields: string; virtual; abstract;
  34.     procedure SetIndexFieldNames(const Value: string); virtual;
  35.     procedure SetIndexName(const Value: string); virtual;
  36.     procedure SetMasterFields(const Value: string); virtual; abstract;
  37.   public
  38.     constructor CreateWith(ADataSet: TDataSet); virtual;
  39.     procedure GetIndexNames(List: TStrings);
  40.     property IndexBased: Boolean read GetIndexBased;
  41.     property IndexDefs: TIndexDefs read GetIndexDefs;
  42.     property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
  43.     property IndexName: string read GetIndexName write SetIndexName;
  44.     property MasterFields: string read GetMasterFields write SetMasterFields;
  45.     property Changed: Boolean read FChanged;
  46.     procedure Edit; override;
  47.     function GetAttributes: TPropertyAttributes; override;
  48.     property DataSet: TDataSet read GetDataSet;
  49.   end;
  50.  
  51. { TLink Fields }
  52.  
  53.   TLinkFields = class(TForm)
  54.     DetailList: TListBox;
  55.     MasterList: TListBox;
  56.     BindList: TListBox;
  57.     Label30: TLabel;
  58.     Label31: TLabel;
  59.     IndexList: TComboBox;
  60.     IndexLabel: TLabel;
  61.     Label2: TLabel;
  62.     Bevel1: TBevel;
  63.     Bevel2: TBevel;
  64.     AddButton: TButton;
  65.     DeleteButton: TButton;
  66.     ClearButton: TButton;
  67.     Button1: TButton;
  68.     Button2: TButton;
  69.     Help: TButton;
  70.     procedure FormCreate(Sender: TObject);
  71.     procedure BindingListClick(Sender: TObject);
  72.     procedure AddButtonClick(Sender: TObject);
  73.     procedure DeleteButtonClick(Sender: TObject);
  74.     procedure BindListClick(Sender: TObject);
  75.     procedure ClearButtonClick(Sender: TObject);
  76.     procedure FormDestroy(Sender: TObject);
  77.     procedure BitBtn1Click(Sender: TObject);
  78.     procedure HelpClick(Sender: TObject);
  79.     procedure IndexListChange(Sender: TObject);
  80.   private
  81.     FDataSet: TDataSet;
  82.     FMasterDataSet: TDataSet;
  83.     FDataSetProxy: TFieldLinkProperty;
  84.     FFullIndexName: string;
  85.     MasterFieldList: string;
  86.     IndexFieldList: string;
  87.     OrderedDetailList: TStringList;
  88.     OrderedMasterList: TStringList;
  89.     procedure OrderFieldList(OrderedList, List: TStrings);
  90.     procedure AddToBindList(const Str1, Str2: string);
  91.     procedure Initialize;
  92.     property FullIndexName: string read FFullIndexName;
  93.     procedure SetDataSet(Value: TDataSet);
  94.   public
  95.     property DataSet: TDataSet read FDataSet write SetDataSet;
  96.     property DataSetProxy: TFieldLinkProperty read FDataSetProxy write FDataSetProxy;
  97.     function Edit: Boolean;
  98.   end;
  99.  
  100. function EditMasterFields(ADataSet: TDataSet; ADataSetProxy: TFieldLinkProperty): Boolean;
  101.  
  102. implementation
  103.  
  104. {$R *.DFM}
  105.  
  106. uses Dialogs, DBConsts, LibHelp, TypInfo, DsnDBCst;
  107.  
  108. { Utility Functions }
  109.  
  110. function StripFieldName(const Fields: string; var Pos: Integer): string;
  111. var
  112.   I: Integer;
  113. begin
  114.   I := Pos;
  115.   while (I <= Length(Fields)) and (Fields[I] <> ';') do Inc(I);
  116.   Result := Copy(Fields, Pos, I - Pos);
  117.   if (I <= Length(Fields)) and (Fields[I] = ';') then Inc(I);
  118.   Pos := I;
  119. end;
  120.  
  121. function StripDetail(const Value: string): string;
  122. var
  123.   S: string;
  124.   I: Integer;
  125. begin
  126.   S := Value;
  127.   I := 0;
  128.   while Pos('->', S) > 0 do
  129.   begin
  130.     I := Pos('->', S);
  131.     S[I] := ' ';
  132.   end;
  133.   Result := Copy(Value, 0, I - 2);
  134. end;
  135.  
  136. function StripMaster(const Value: string): string;
  137. var
  138.   S: string;
  139.   I: Integer;
  140. begin
  141.   S := Value;
  142.   I := 0;
  143.   while Pos('->', S) > 0 do
  144.   begin
  145.     I := Pos('->', S);
  146.     S[I] := ' ';
  147.   end;
  148.   Result := Copy(Value, I + 3, Length(Value));
  149. end;
  150.  
  151. function EditMasterFields(ADataSet: TDataSet; ADataSetProxy: TFieldLinkProperty): Boolean;
  152. begin
  153.   with TLinkFields.Create(nil) do
  154.   try
  155.     DataSetProxy := ADataSetProxy;
  156.     DataSet := ADataSet;
  157.     Result := Edit;
  158.   finally
  159.     Free;
  160.   end;
  161. end;
  162.  
  163. { TFieldLinkProperty }
  164.  
  165. function TFieldLinkProperty.GetIndexBased: Boolean;
  166. begin
  167.   Result := False;
  168. end;
  169.  
  170. function TFieldLinkProperty.GetIndexDefs: TIndexDefs;
  171. begin
  172.   Result := nil;
  173. end;
  174.  
  175. function TFieldLinkProperty.GetIndexFieldNames: string;
  176. begin
  177.   Result := '';
  178. end;
  179.  
  180. function TFieldLinkProperty.GetIndexName: string;
  181. begin
  182.   Result := '';
  183. end;
  184.  
  185. procedure TFieldLinkProperty.GetIndexNames(List: TStrings);
  186. var
  187.   i: Integer;
  188. begin
  189.   if IndexDefs <> nil then
  190.     for i := 0 to IndexDefs.Count - 1 do
  191.       if (ixPrimary in IndexDefs.Items[i].Options) and
  192.          (IndexDefs.Items[i].Name = '') then
  193.         List.Add(SPrimary) else
  194.         List.Add(IndexDefs.Items[i].Name);
  195. end;
  196.  
  197. procedure TFieldLinkProperty.GetFieldNamesForIndex(List: TStrings);
  198. begin
  199. end;
  200.  
  201. procedure TFieldLinkProperty.SetIndexFieldNames(const Value: string);
  202. begin
  203. end;
  204.  
  205. procedure TFieldLinkProperty.SetIndexName(const Value: string);
  206. begin
  207. end;
  208.  
  209. function TFieldLinkProperty.GetAttributes: TPropertyAttributes;
  210. begin
  211.   Result := [paDialog];
  212. end;
  213.  
  214. procedure TFieldLinkProperty.Edit;
  215. begin
  216.   FChanged := EditMasterFields(DataSet, Self);
  217.   if FChanged then Modified;
  218. end;
  219.  
  220. constructor TFieldLinkProperty.CreateWith(ADataSet: TDataSet);
  221. begin
  222.   FDataSet := ADataSet;
  223. end;
  224.  
  225. function TFieldLinkProperty.GetDataSet: TDataSet;
  226. begin
  227.   if FDataSet = nil then
  228.     FDataSet := TDataSet(GetComponent(0));
  229.   Result := FDataSet;
  230. end;
  231.  
  232. { TLinkFields }
  233.  
  234. procedure TLinkFields.FormCreate(Sender: TObject);
  235. begin
  236.   OrderedDetailList := TStringList.Create;
  237.   OrderedMasterList := TStringList.Create;
  238.   HelpContext := hcDFieldLinksDesign;
  239. end;
  240.  
  241. procedure TLinkFields.FormDestroy(Sender: TObject);
  242. begin
  243.   OrderedDetailList.Free;
  244.   OrderedMasterList.Free;
  245. end;
  246.  
  247. function TLinkFields.Edit;
  248. begin
  249.   Initialize;
  250.   if ShowModal = mrOK then
  251.   begin
  252.     if FullIndexName <> '' then
  253.       DataSetProxy.IndexName := FullIndexName else
  254.       DataSetProxy.IndexFieldNames := IndexFieldList;
  255.     DataSetProxy.MasterFields := MasterFieldList;
  256.     Result := True;
  257.   end
  258.   else
  259.     Result := False;
  260. end;
  261.  
  262. procedure TLinkFields.SetDataSet(Value: TDataSet);
  263. var
  264.   IndexDefs: TIndexDefs;
  265. begin
  266.   Value.FieldDefs.Update;
  267.   IndexDefs := DataSetProxy.IndexDefs;
  268.   if Assigned(IndexDefs) then IndexDefs.Update;
  269.   if not Assigned(Value.DataSource) or not Assigned(Value.DataSource.DataSet) then
  270.     DatabaseError(SMissingDataSource, Value);
  271.   Value.DataSource.DataSet.FieldDefs.Update;
  272.   FDataSet := Value;
  273.   FMasterDataSet := Value.DataSource.DataSet;
  274. end;
  275.  
  276. procedure TLinkFields.Initialize;
  277. var
  278.   SIndexName: string;
  279.  
  280.   procedure SetUpLists(const MasterFieldList, DetailFieldList: string);
  281.   var
  282.     I, J: Integer;
  283.     MasterFieldName, DetailFieldName: string;
  284.   begin
  285.     I := 1;
  286.     J := 1;
  287.     while (I <= Length(MasterFieldList)) and (J <= Length(DetailFieldList)) do
  288.     begin
  289.       MasterFieldName := StripFieldName(MasterFieldList, I);
  290.       DetailFieldName := StripFieldName(DetailFieldList, J);
  291.       if (MasterList.Items.IndexOf(MasterFieldName) <> -1) and
  292.         (OrderedDetailList.IndexOf(DetailFieldName) <> -1) then
  293.       begin
  294.         with OrderedDetailList do
  295.           Objects[IndexOf(DetailFieldName)] := TObject(True);
  296.         with DetailList.Items do Delete(IndexOf(DetailFieldName));
  297.         with MasterList.Items do Delete(IndexOf(MasterFieldName));
  298.         BindList.Items.Add(Format('%s -> %s',
  299.           [DetailFieldName, MasterFieldName]));
  300.         ClearButton.Enabled := True;
  301.       end;
  302.     end;
  303.   end;
  304.  
  305. begin
  306.   if not DataSetProxy.IndexBased then
  307.   begin
  308.     IndexLabel.Visible := False;
  309.     IndexList.Visible := False;
  310.   end
  311.   else with DataSetProxy do
  312.   begin
  313.     GetIndexNames(IndexList.Items);
  314.     if IndexFieldNames <> '' then
  315.       SIndexName := IndexDefs.FindIndexForFields(IndexFieldNames).Name
  316.     else SIndexName := IndexName;
  317.     if (SIndexName <> '') and (IndexList.Items.IndexOf(SIndexName) >= 0) then
  318.       IndexList.ItemIndex := IndexList.Items.IndexOf(SIndexName) else
  319.       IndexList.ItemIndex := 0;
  320.   end;
  321.   with DataSetProxy do
  322.   begin
  323.     MasterFieldList := MasterFields;
  324.     if (IndexFieldNames = '') and (IndexName <> '') and
  325.       (IndexDefs.IndexOf(IndexName) >=0) then
  326.       IndexFieldList := IndexDefs[IndexDefs.IndexOf(IndexName)].Fields else
  327.       IndexFieldList := IndexFieldNames;
  328.   end;
  329.   IndexListChange(nil);
  330.   FMasterDataSet.GetFieldNames(MasterList.Items);
  331.   OrderedMasterList.Assign(MasterList.Items);
  332.   SetUpLists(MasterFieldList, IndexFieldList);
  333. end;
  334.  
  335. procedure TLinkFields.IndexListChange(Sender: TObject);
  336. var
  337.   I: Integer;
  338.   IndexExp: string;
  339. begin
  340.   DetailList.Items.Clear;
  341.   if DataSetProxy.IndexBased then
  342.   begin
  343.     DataSetProxy.IndexName := IndexList.Text;
  344.     I := DataSetProxy.IndexDefs.IndexOf(DataSetProxy.IndexName);
  345.     if (I <> -1) then IndexExp := DataSetProxy.IndexDefs.Items[I].Expression;
  346.     if IndexExp <> '' then
  347.       DetailList.Items.Add(IndexExp) else
  348.       DataSetProxy.GetFieldNamesForIndex(DetailList.Items);
  349.   end else
  350.     DataSet.GetFieldNames(DetailList.Items);
  351.   MasterList.Items.Assign(OrderedMasterList);
  352.   OrderedDetailList.Assign(DetailList.Items);
  353.   for I := 0 to OrderedDetailList.Count - 1 do
  354.     OrderedDetailList.Objects[I] := TObject(False);
  355.   BindList.Clear;
  356.   AddButton.Enabled := False;
  357.   ClearButton.Enabled := False;
  358.   DeleteButton.Enabled := False;
  359.   MasterList.ItemIndex := -1;
  360. end;
  361.  
  362. procedure TLinkFields.OrderFieldList(OrderedList, List: TStrings);
  363. var
  364.   I, J: Integer;
  365.   MinIndex, Index, FieldIndex: Integer;
  366. begin
  367.   for J := 0 to List.Count - 1 do
  368.   begin
  369.     MinIndex := $7FFF;
  370.     FieldIndex := -1;
  371.     for I := J to List.Count - 1 do
  372.     begin
  373.       Index := OrderedList.IndexOf(List[I]);
  374.       if Index < MinIndex then
  375.       begin
  376.         MinIndex := Index;
  377.         FieldIndex := I;
  378.       end;
  379.     end;
  380.     List.Move(FieldIndex, J);
  381.   end;
  382. end;
  383.  
  384. procedure TLinkFields.AddToBindList(const Str1, Str2: string);
  385. var
  386.   I: Integer;
  387.   NewField: string;
  388.   NewIndex: Integer;
  389. begin
  390.   NewIndex := OrderedDetailList.IndexOf(Str1);
  391.   NewField := Format('%s -> %s', [Str1, Str2]);
  392.   with BindList.Items do
  393.   begin
  394.     for I := 0 to Count - 1 do
  395.     begin
  396.       if OrderedDetailList.IndexOf(StripDetail(Strings[I])) > NewIndex then
  397.       begin
  398.         Insert(I, NewField);
  399.         Exit;
  400.       end;
  401.     end;
  402.     Add(NewField);
  403.   end;
  404. end;
  405.  
  406. procedure TLinkFields.BindingListClick(Sender: TObject);
  407. begin
  408.   AddButton.Enabled := (DetailList.ItemIndex <> LB_ERR) and
  409.     (MasterList.ItemIndex <> LB_ERR);
  410. end;
  411.  
  412. procedure TLinkFields.AddButtonClick(Sender: TObject);
  413. var
  414.   DetailIndex: Integer;
  415.   MasterIndex: Integer;
  416. begin
  417.   DetailIndex := DetailList.ItemIndex;
  418.   MasterIndex := MasterList.ItemIndex;
  419.   AddToBindList(DetailList.Items[DetailIndex],
  420.     MasterList.Items[MasterIndex]);
  421.   with OrderedDetailList do
  422.     Objects[IndexOf(DetailList.Items[DetailIndex])] := TObject(True);
  423.   DetailList.Items.Delete(DetailIndex);
  424.   MasterList.Items.Delete(MasterIndex);
  425.   ClearButton.Enabled := True;
  426.   AddButton.Enabled := False;
  427. end;
  428.  
  429. procedure TLinkFields.ClearButtonClick(Sender: TObject);
  430. var
  431.   I: Integer;
  432.   BindValue: string;
  433. begin
  434.   for I := 0 to BindList.Items.Count - 1 do
  435.   begin
  436.     BindValue := BindList.Items[I];
  437.     DetailList.Items.Add(StripDetail(BindValue));
  438.     MasterList.Items.Add(StripMaster(BindValue));
  439.   end;
  440.   BindList.Clear;
  441.   ClearButton.Enabled := False;
  442.   DeleteButton.Enabled := False;
  443.   OrderFieldList(OrderedDetailList, DetailList.Items);
  444.   DetailList.ItemIndex := -1;
  445.   MasterList.Items.Assign(OrderedMasterList);
  446.   for I := 0 to OrderedDetailList.Count - 1 do
  447.     OrderedDetailList.Objects[I] := TObject(False);
  448.   AddButton.Enabled := False;
  449. end;
  450.  
  451. procedure TLinkFields.DeleteButtonClick(Sender: TObject);
  452. var
  453.   I: Integer;
  454. begin
  455.   with BindList do
  456.   begin
  457.     for I := Items.Count - 1 downto 0 do
  458.     begin
  459.       if Selected[I] then
  460.       begin
  461.         DetailList.Items.Add(StripDetail(Items[I]));
  462.         MasterList.Items.Add(StripMaster(Items[I]));
  463.         with OrderedDetailList do
  464.           Objects[IndexOf(StripDetail(Items[I]))] := TObject(False);
  465.         Items.Delete(I);
  466.       end;
  467.     end;
  468.     if Items.Count > 0 then Selected[0] := True;
  469.     DeleteButton.Enabled := Items.Count > 0;
  470.     ClearButton.Enabled := Items.Count > 0;
  471.     OrderFieldList(OrderedDetailList, DetailList.Items);
  472.     DetailList.ItemIndex := -1;
  473.     OrderFieldList(OrderedMasterList, MasterList.Items);
  474.     MasterList.ItemIndex := -1;
  475.     AddButton.Enabled := False;
  476.   end;
  477. end;
  478.  
  479. procedure TLinkFields.BindListClick(Sender: TObject);
  480. begin
  481.   DeleteButton.Enabled := BindList.ItemIndex <> LB_ERR;
  482. end;
  483.  
  484. procedure TLinkFields.BitBtn1Click(Sender: TObject);
  485. var
  486.   Gap: Boolean;
  487.   I: Integer;
  488.   FirstIndex: Integer;
  489. begin
  490.   FirstIndex := -1;
  491.   MasterFieldList := '';
  492.   IndexFieldList := '';
  493.   FFullIndexName := '';
  494.   if DataSetProxy.IndexBased then
  495.   begin
  496.     Gap := False;
  497.     for I := 0 to OrderedDetailList.Count - 1  do
  498.     begin
  499.       if Boolean(OrderedDetailList.Objects[I]) then
  500.       begin
  501.         if Gap then
  502.         begin
  503.           MessageDlg(Format(SLinkDesigner,
  504.             [OrderedDetailList[FirstIndex]]), mtError, [mbOK], 0);
  505.           ModalResult := 0;
  506.           DetailList.ItemIndex := DetailList.Items.IndexOf(OrderedDetailList[FirstIndex]);
  507.           Exit;
  508.         end;
  509.       end
  510.       else begin
  511.         Gap := True;
  512.         if FirstIndex = -1 then FirstIndex := I;
  513.       end;
  514.     end;
  515.     if not Gap then FFullIndexName := DataSetProxy.IndexName;
  516.   end;
  517.   with BindList do
  518.   begin
  519.     for I := 0 to Items.Count - 1 do
  520.     begin
  521.       MasterFieldList := Format('%s%s;', [MasterFieldList, StripMaster(Items[I])]);
  522.       IndexFieldList := Format('%s%s;', [IndexFieldList, StripDetail(Items[I])]);
  523.     end;
  524.     if MasterFieldList <> '' then
  525.       SetLength(MasterFieldList, Length(MasterFieldList) - 1);
  526.     if IndexFieldList <> '' then
  527.       SetLength(IndexFieldList, Length(IndexFieldList) - 1);
  528.   end;
  529. end;
  530.  
  531. procedure TLinkFields.HelpClick(Sender: TObject);
  532. begin
  533.   Application.HelpContext(HelpContext);
  534. end;
  535.  
  536. end.
  537.